home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 1 / Pier Shareware 1.iso / 007a / courspas.exe / CHAP12.EXE / LISTE2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-06  |  3KB  |  129 lines
  1. program DemoListes2;  {LISTE2.PAS}
  2.  
  3. uses
  4.   crt;  { unité de Turbo Pascal 6 }
  5.  
  6. type
  7.   pointeur = ^person;
  8.   person = record
  9.              nom    : string;
  10.              suivant: pointeur;
  11.            end;
  12.  
  13. var
  14.   origine,p1,p2: pointeur;
  15.  
  16. {------------------------------------------------}
  17. { saisie_liste                                   }
  18. {------------------------------------------------}
  19. procedure saisie_liste;
  20. begin
  21.   clrscr;
  22.   origine:= nil;
  23.   new(p1);
  24.   p1^.suivant:= origine;
  25.   origine:=p1;
  26.   write('Introduisez les noms constituant la liste, ');
  27.   writeln('(<CR> pour la clore).');
  28.   writeln;
  29.   write('Nom: ');
  30.   readln(p1^.nom);
  31.   writeln;
  32.   if p1^.nom <> '' then
  33.   begin
  34.     new(p2);
  35.     write('Nom: ');
  36.     readln(p2^.nom);
  37.     writeln;
  38.     while p2^.nom <> '' do
  39.     begin
  40.       p2^.suivant:= nil; {pointeur suivant sur NIL}
  41.       p1^.suivant:= p2;
  42.       p1:= p2;
  43.       new(p2);
  44.       write('Nom: ');
  45.       readln(p2^.nom);
  46.       writeln;
  47.     end; { while }
  48.   end; { if }
  49. end;
  50. {------------------------------------------------}
  51. { afficher_liste                                 }
  52. {------------------------------------------------}
  53. procedure afficher_liste;
  54. begin
  55.   clrscr;
  56.   writeln('Liste des noms saisis:');
  57.   writeln;
  58.   p1:=origine;
  59.   while p1 <> nil do
  60.   begin
  61.     writeln(p1^.nom);
  62.     p1:=p1^.suivant;
  63.   end;
  64.   writeln('Veuillez frapper <CR>');
  65.   readln;
  66. end;
  67. {------------------------------------------------}
  68. { suppress_element                               }
  69. {------------------------------------------------}
  70. procedure suppress_element;
  71. var
  72.   nom: string;
  73.  
  74. begin
  75.   writeln('Veuillez frapper le nom que vous désirez supprimer: ');
  76.   readln(nom);
  77.   repeat;
  78.     p1:=origine;
  79.     if p1^.nom=nom then origine:=p1^.suivant;
  80.   until (p1^.nom <>nom) or (p1^.suivant = nil);
  81.   while p1<>nil do
  82.   begin
  83.     p2:=p1^.suivant;
  84.     if p2^.nom = nom
  85.     then begin
  86.            p2:=p2^.suivant;
  87.            p1^.suivant:=p2;
  88.          end
  89.     else p1:=p2;
  90.   end;
  91. end;
  92. {------------------------------------------------}
  93. { insert_element                                 }
  94. {------------------------------------------------}
  95. procedure insert_element;
  96. var
  97.   nom1,nom2: string;
  98.  
  99. begin
  100.   write('Veuillez frapper le nom que vous désirez insérer  : ');
  101.   readln (nom1);
  102.   writeln;
  103.   writeln('et celui derrière lequel il doit figurer          : ');
  104.   readln(nom2);
  105.   p1:=origine;
  106.   while p1 <> nil do
  107.   begin
  108.     if p1^.nom=nom2 then
  109.     begin
  110.        new(p2);
  111.        p2^.nom:=nom1;
  112.        p2^.suivant:=p1^.suivant;
  113.        p1^.suivant:=p2;
  114.        dispose(p2);
  115.     end; { if }
  116.     p1:=p1^.suivant;
  117.   end; { while }
  118. end;
  119. {------------------------------------------------}
  120.  
  121. begin  { programme principal }
  122.   saisie_liste;
  123.   afficher_liste;
  124.   suppress_element;
  125.   afficher_liste;
  126.   insert_element;
  127.   afficher_liste;
  128. end.
  129.